home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / EUPHOR10.ZIP;1 / SANITY.EX < prev    next >
Encoding:
Text File  |  1993-06-15  |  14.6 KB  |  739 lines
  1. -- io test
  2.         -----------------------------------------
  3.         -- AUTOMATIC SELF-CHECKING SANITY TEST --
  4.         -- FOR Euphoria                    --
  5.         -----------------------------------------
  6. with type_check
  7.  
  8. include get.e
  9. include graphics.e
  10. include sort.e
  11.  
  12. trace(0)
  13.  
  14. constant msg = 1 -- place to send messages
  15.  
  16. global object y, i, r
  17.  
  18. procedure make_sound()
  19. -- test sound() built-in
  20.     for i = 500 to 5000 by 500 do
  21.     sound(i)
  22.     for j = 1 to 100000 do
  23.     end for
  24.     sound(0)
  25.     end for
  26. end procedure
  27.  
  28. procedure abort()
  29. -- force abort with trace back
  30.     puts(msg, "divide by 0 to get trace back...\n")
  31.     ? 1/0
  32. end procedure
  33.  
  34. procedure show(object x, object y)
  35. -- show the mismatched values
  36.     puts(msg, "\n   ---MISMATCH--- \n   x is ")
  37.     ? x
  38.     puts(msg, "   y is ")
  39.     ? y
  40.     abort()
  41. end procedure
  42.  
  43. constant epsilon = 1e-10
  44.  
  45. procedure same(object x, object y)
  46. -- object x must be identical to object y else abort program
  47.     atom ratio
  48.  
  49.     if atom(x) and atom(y) then
  50.     if x = y then
  51.         return
  52.     else
  53.         if y = 0 then
  54.         show(x, y)
  55.         else
  56.         ratio = x / y
  57.         if ratio < 1 - epsilon or ratio > 1 + epsilon then
  58.             show(x, y)
  59.         end if
  60.         end if
  61.     end if
  62.     elsif length(x) = length(y) then
  63.     for i = 1 to length(x) do
  64.         same(x[i], y[i])
  65.     end for
  66.     else
  67.     show(x, y)
  68.     end if
  69. end procedure
  70.  
  71. ----------------------------------------------------------
  72. function abs(atom x)
  73. -- absolute value
  74.     if x < 0 then
  75.     return -x
  76.     else
  77.     return x
  78.     end if
  79. end function
  80.  
  81. function built_in()
  82. -- built-in tests
  83.     sequence d
  84.  
  85.     d = date()
  86.     if d[1] < 93 or d[2] > 12 or d[3] < 1 or d[4] > 23 or d[5] > 59 or
  87.     d[6] >59 or d[7] > 7  or d[8] > 366 then
  88.     abort()
  89.     end if
  90.     d = power({-5, -4.5, -1,  0, 1,  2,  3.5, 4, 6},
  91.           { 3,    2, -1,0.5, 0, 29, -2.5, 5, 8})
  92.     if d[1] != -125 or d[2] != 20.25 or d[3] != -1 or d[4] != 0 or
  93.        d[5] != 1 or d[6] != 536870912 or d[7] <.043 or d[7] > .044
  94.     or d[8] != 1024 or d[9] != 1679616 or power(2,3) != 8 or
  95.     power(16, 0.5) != 4 then
  96.     abort()
  97.     end if
  98.     d = remainder({5, 9, 15, -27}, {3, 4, 5, 6})
  99.     if d[1] != 2 or d[2] != 1 or d[3] != 0 or d[4] != -3 then
  100.     abort()
  101.     end if
  102.     d = remainder({11.5, -8.8, 3.5, 5.0}, {2, 3.5, -1.5, -100.0})
  103.     if d[1] != 1.5 or d[2] < -1.81 or d[2] > -1.79 or d[3] != 0.5 or d[4] != 5 then
  104.     abort()
  105.     end if
  106.     same(4, sqrt(16))
  107.     same(3, length("ABC"))
  108.     same({1, 1, 1, 1}, repeat(1, 4))
  109.     if rand(10) > 10 or rand(20) < 1 or not find(rand(5.5), {1,2,3,4,5}) then
  110.     abort()
  111.     end if
  112.     if time() < 0 then
  113.     abort()
  114.     end if
  115.     if abs(sin(3.1415)) > 0.02 then
  116.     abort()
  117.     end if
  118.     if cos(0) < .98 then
  119.     abort()
  120.     end if
  121.     if abs(tan(3.14/4) - 1) > .02 then
  122.     abort()
  123.     end if
  124.     if log(2.7) < 0.8 or log(2.7) > 1.2 then
  125.     abort()
  126.     end if
  127.     if floor(-3.3) != -4 then
  128.     abort()
  129.     end if
  130.     if floor(-999/3.000000001) != -333 then
  131.     abort()
  132.     end if
  133.     if floor(9.99/1) != 9 then
  134.     abort()
  135.     end if
  136.     for i = -9 to 2 do
  137.     if i = 1 then
  138.         return i
  139.     end if
  140.     end for
  141. end function
  142.  
  143. procedure sub()
  144.     y = 200
  145. end procedure
  146.  
  147. procedure overflow()
  148. -- test overflows from integer into floating point
  149.     object two29, two30, maxint, prev_i
  150.     integer two30i, mtwo30i
  151.  
  152.     two30 = 1
  153.     for i = 1 to 30 do
  154.     two30 = two30 * 2
  155.     end for
  156.     mtwo30i = -1
  157.     for i = 1 to 29 do
  158.     mtwo30i = mtwo30i * 2
  159.     end for
  160.     two30i = 1
  161.     for i = 1 to 29 do
  162.     two30i = two30i * 2
  163.     end for
  164.     if 2 * two30i != -2 * mtwo30i then
  165.     abort()
  166.     end if
  167.     if two30i*2 != two30 then
  168.     abort()
  169.     end if
  170.     two29 = floor(two30 / 2)
  171.     if two29 + two29 != two30 then
  172.        abort()
  173.     end if
  174.     maxint = floor(two30 - 1)
  175.     if maxint + 1 != two30 then
  176.     abort()
  177.     end if
  178.     if 2 + maxint != two30 + 1 then
  179.     abort()
  180.     end if
  181.     if (-maxint - 1) * -1 != two30 then
  182.     abort()
  183.     end if
  184.  
  185.     prev_i = -maxint + 1
  186.     for i = -maxint to -maxint -5 by -1 do
  187.     if i != prev_i - 1 then
  188.         abort()
  189.     end if
  190.     prev_i = i
  191.     end for
  192.  
  193.     prev_i = maxint - 5
  194.     for i = maxint - 3 to maxint + 3 by 2 do
  195.     if i != prev_i + 2 then
  196.         abort()
  197.     end if
  198.     prev_i = i
  199.     end for
  200.  
  201.     if floor(two30) != two30 then
  202.     abort()
  203.     end if
  204.  
  205.     if floor(two30 + two30 - 1) != two30 * 2 - 1 then
  206.     abort()
  207.     end if
  208. end procedure
  209.  
  210. procedure atomic_ops()
  211. -- test operations on atoms
  212.     object a, x, z
  213.     integer n
  214.  
  215.     x = 100
  216.     sub() -- y = 200
  217.     z = 300
  218.  
  219.     if x + y != z then
  220.     abort()
  221.     end if
  222.  
  223.     if x != 100 then
  224.     abort()
  225.     end if
  226.  
  227.     if 3 * 3 != 9 or
  228.        3 * 900000000 != 2700000000 or
  229.        15000 * 32000 != 480000000 or
  230.        32000 * 15000 != 480000000 or
  231.        1000 * 13000 != 13000000 or
  232.        13000 * 1000 != 13000000 then
  233.     abort()
  234.     end if
  235.     while x != 100 do
  236.     abort()
  237.     end while
  238.  
  239.     if not (z - y = 100) then
  240.     abort()
  241.     end if
  242.  
  243.     if x * 1000.5 != 100050 or x * y != 20000 or x / y != 0.5 then
  244.     abort()
  245.     end if
  246.  
  247.     if y < x then
  248.     abort()
  249.     end if
  250.  
  251.     if y <= x then
  252.     abort()
  253.     end if
  254.  
  255.     if x > y then
  256.     abort()
  257.     end if
  258.  
  259.     if x >= y then
  260.     abort()
  261.     end if
  262.  
  263.     if -x != -100 then
  264.     printf(1, "x is %d\n", x)
  265.     abort()
  266.     end if
  267.  
  268.     if x = x and y > z then
  269.     abort()
  270.     end if
  271.  
  272.     x = 0
  273.  
  274.     y = {"ten", "one", "two", "three", "four", "five", "six", "seven", "eight",
  275.      "nine", "ten", "ten"}
  276.  
  277.     while x <= 11 do
  278.     if x = 1 then a = "one"
  279.     elsif x = 2 then a = "two"
  280.     elsif x = 3 then a = "three"
  281.     elsif x = 4 then a = "four"
  282.     elsif x = 5 then a = "five"
  283.     elsif x = 6 then a = "six"
  284.     elsif x = 7 then a = "seven"
  285.              if 1 + 1 = 2 then
  286.                  same(a, "seven")
  287.              elsif 1 + 1 = 3 then
  288.                  abort()
  289.              else
  290.                  abort()
  291.              end if
  292.     elsif x = 8 then a = "eight"
  293.     elsif x = 9 then a = "nine"
  294.     else a = "ten"
  295.     end if
  296.     same(a, y[1+x])
  297.     x = x + 1
  298.     end while
  299.  
  300.     y = 0
  301.     for xx = 100 to 0 by -2 do
  302.     y = y + xx
  303.     end for
  304.     same(y, 50 * 51)
  305.  
  306.     for xx = 1 to 10 do
  307.     if xx = 6 then
  308.         x = 6
  309.         exit
  310.     end if
  311.     y = 1
  312.     while y < 25 do
  313.         y = y + 1
  314.         if y = 18 then
  315.         exit
  316.         end if
  317.     end while
  318.     same(y, 18)
  319.     end for
  320.     y = repeat(-99, 7)
  321.     for xx = +3 to -3 by -1 do
  322.     y[xx+4] = xx
  323.     end for
  324.     same(y, {-3, -2, -1, 0, +1, +2, +3})
  325.  
  326.     y = {1,2,3}
  327.     for xx = 1.5 to +3.0 by .5 do
  328.       y[xx] = xx
  329.     end for
  330.     same(y, {1.5, 2.5, 3.0})
  331.     y = {}
  332.     for xx = -9.0 to -9.5 by -.25 do
  333.       y = y & xx
  334.     end for
  335.     same(y, {-9, -9.25, -9.5})
  336.     y = 5
  337.     n = 3
  338.     a = 2
  339.     for i = 1 to y by a do
  340.     n = n - 1
  341.     y = 15
  342.     a = 1
  343.     end for
  344.     same(n, 0)
  345. end procedure
  346.  
  347. procedure floating_pt()
  348. -- test floating-point operations
  349. sequence x
  350.     x = {1.5, -3.5, 1e10, -1e20, 0.0, 0.0001}
  351.     y = repeat(x, 10)
  352.     if x[1]/x[2] > -0.42 or x[1]/x[2] < -0.43 then
  353.     abort()
  354.     end if
  355.     if find(1e10, x) != 3 then
  356.     abort()
  357.     end if
  358. end procedure
  359.  
  360. function sequence_ops()
  361. -- test operations on sequences
  362.     object i, w, x, y, z
  363.  
  364.     x = "Hello "
  365.     y = "World"
  366.  
  367.     i = 1
  368.     if not atom(i) then print(msg, 11) end if
  369.     if length(y) != 5 then print(msg, 12) end if
  370.     while i <= 5 do
  371.     x = append(x, y[i])
  372.     i = i + 1
  373.     end while
  374.     i = 1
  375.     while i <= 3 do
  376.     x = append(x, '.')
  377.     x = append(x, '\'')
  378.     i = i + 1
  379.     end while
  380.     same(x, "Hello World.'.'.'")
  381.     x = repeat(5, 19)
  382.     x = append(x, 20)
  383.     x[7] = 9
  384.     y = {9, 9, {9}}
  385.     y = prepend(y, 8)
  386.     y = prepend(y, {9, 9})
  387.     same(y, {{9, 9}, 8, 9, 9, {9}})
  388.     y = x
  389.     z = y * x + x + 1000
  390.     w = z > 1030 or x = 9
  391.     same(z, {1030, 1030, 1030, 1030, 1030, 1030, 1090, 1030, 1030, 1030,
  392.          1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1420})
  393.     same(w, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
  394.          0, 0, 0, 0, 0, 0, 0, 0, 0, 1})
  395.     x = {100, 200, {1, 2, {0, 0, 0}}, 300}
  396.     x[3][3][3] = 25
  397.     x = x * x
  398.     same(x, {10000, 40000, {1, 4, {0, 0, 625}}, 90000})
  399.     y = x / {1, 2, 3, 4}
  400.     same(y, {10000, 20000, {1/3, 4/3, {0, 0, 625/3}}, 22500})
  401.     -- & tests
  402.  
  403.     same(2 & {5, 6,7}, {2, 5, 6, 7})
  404.     same({} & 3, {3})
  405.     same("ABC" & "DEF" & "GHIJ" & {}, "ABCDEFGHIJ")
  406.     same('A' & 'B' & 'C', "ABC")
  407.  
  408.     -- slice tests
  409.     x = "ABCDEFGHIJKLMNOP"
  410.     same(x[1..4], "ABCD")
  411.     y = x[2..5]
  412.     same(y, "BCDE")
  413.     same(x[4..3], {})
  414.     same(x[4..4], "D")
  415.     x[3..5] = "000"
  416.     same(x, "AB000FGHIJKLMNOP")
  417.     x[6..9] = '8'
  418.     same(x, "AB0008888JKLMNOP")
  419.  
  420.     same(floor({1, 2, -3, 4, -5} / 3), {0, 0, -1, 1, -2})
  421.  
  422.     return y
  423. end function
  424.  
  425.  
  426. procedure sequence_ops2()
  427. -- more tests of sequence operations
  428. object x, y
  429.  
  430.     x = "ABCDEFGHIJKLMNOP"
  431.     if find('D', x) != 4 then
  432.     abort()
  433.     end if
  434.     if match("EFGH", x) != 5 then
  435.     abort()
  436.     end if
  437.     if compare(x,x) != 0 then
  438.     abort()
  439.     end if
  440.     if compare({}, {}) != 0 then
  441.     abort()
  442.     end if
  443.     y = repeat(repeat(repeat(99, 5), 5), 5)
  444.     if y[3][3][3] != 99 then
  445.     abort()
  446.     end if
  447.     if compare(y[4][4][3..5], repeat(99, 3)) != 0 then
  448.     abort()
  449.     end if
  450.     y[3][2][1..4] = 88
  451.     if compare(y[3][2], {88, 88, 88, 88, 99}) != 0 then
  452.     abort()
  453.     end if
  454. end procedure
  455.  
  456. procedure circularity()
  457. -- test for circular references in internal garbage collector
  458.     object x, y
  459.  
  460.     x = {{"abc", {0, 0, 0}}, "def", 1, 2}
  461.     x[3] = x
  462.     x[1..2] = x[2..3]
  463.     x = append(x, x)
  464.     x = prepend(x, x)
  465.     if compare(x, x) != 0 then
  466.     abort()
  467.     end if
  468.     y = "ABCDE"
  469.     y[2] = repeat(y, 3)
  470.     if compare(y, y) != 0 then
  471.     abort()
  472.     end if
  473. end procedure
  474.  
  475. procedure I_O()
  476. -- test I/O routines
  477.     integer file_no
  478.     object line
  479.  
  480.     file_no = open("sanity.ex", "r")
  481.     if file_no < 0 then
  482.     abort()
  483.     end if
  484.     line = gets(file_no)
  485.     if compare(line, "-- io test\n") != 0 then
  486.     abort()
  487.     end if
  488.     close(file_no)
  489. end procedure
  490.  
  491. procedure testgr()
  492. -- test graphics operations
  493.     draw_line(1, 3, {{20, 100}, {600, 100}})
  494.     for i = 1 to 200 by 5 do
  495.     pixel(7, {i, i})
  496.     end for
  497. end procedure
  498.  
  499. procedure testget()
  500. -- test input of Euphoria objects
  501.     object gd
  502.     object x, i
  503.     object results
  504.  
  505.     gd = open("get.tst", "r")
  506.     results = {
  507.      {0, {11, {33, {33}}, 4, 5}},
  508.      {0, {}},
  509.      {0, {}},
  510.      {0, 0.999},
  511.      {0, -0.999},
  512.      {0, 1.55},
  513.      {0, {11, 22, {33, 33}, 4, 5}},
  514.      {0, 10000},
  515.      {0, -123},
  516.      {0, 5.5},
  517.      {0, 99},
  518.      {0, 1001},
  519.      {0, {1, 2, 3}},
  520.      {0, 0.0001},
  521.      {0, {1.002e+23, -0.00059, 5.9e+31}},
  522.      {0, -1e-20},
  523.      {0, -1},
  524.      {0, "Rob""ert"},
  525.      {0, "Craig"},
  526.      {0, ""},
  527.      {0, "\n"},
  528.      {0, "\t\r"},
  529.      {0, "\'\""},
  530.      {0, 'A'},
  531.      {0, '\n'},
  532.      {0, '\"'},
  533.      {0, '\''},
  534.      {0, '\r'},
  535.      {0, {123, "ABC"}},
  536.      {0, {'A', 'B', '\n'}},
  537.      {-1, 0}
  538.     }
  539.     i = 1
  540.     while 1 do
  541.     x = get(gd)
  542.     if x[1] = -1 then
  543.         exit
  544.     end if
  545.     same(x, results[i])
  546.     i = i + 1
  547.     end while
  548.     if compare(results[i], {-1, 0}) != 0 then
  549.     puts(2, "wrong number of get values\n")
  550.     end if
  551. end procedure
  552.  
  553. sequence list
  554. list = {50, 100, 25, 2, 89, 93, 57, 22, 1, 5, 99, 87, 82, 84, 77, 76, 76,
  555.     33, 22, 11, 2, 3, 4, 98, 97, 82, 73, 55, 44, 29, 8, 7, 6, 5, 31,
  556.     42, 53, 54, 62, 69, 70, 80, 90, 96, 200, 300, 400, 1000, 999,
  557.     500, 600, 800, 700, 750, 444, 333, 222, 111, 888, 987, 901}
  558.  
  559. constant TRUE = 1, FALSE = 0
  560.  
  561. type positive_int(integer x)
  562.     return x >= 0
  563. end type
  564.  
  565. global type sorted(sequence x)
  566. -- return TRUE if x is in ascending order
  567. positive_int n
  568.  
  569.     n = length(x)
  570.     if n >= 2 then
  571.     for i = 1 to n-1 do
  572.         if compare(x[i], x[i+1]) > 0 then
  573.         return FALSE
  574.         end if
  575.     end for
  576.     end if
  577.     return TRUE
  578. end type
  579.  
  580. global function merge_sort(sequence x)
  581. -- put x into ascending order
  582. -- using recursive merge sort
  583.     positive_int n
  584.     sorted x1, x2, newx
  585.  
  586.     n = length(x)
  587.     if n = 0 or n = 1 then
  588.     return x
  589.     end if
  590.  
  591.     x1 = merge_sort(x[1..n/2])
  592.     x2 = merge_sort(x[n/2+1..n])
  593.     newx = {}
  594.  
  595.     while length(x1) > 0 and length(x2) > 0 do
  596.     if x1[1] < x2[1] then
  597.         newx = append(newx, x1[1])
  598.         x1 = x1[2..length(x1)]
  599.     else
  600.         newx = append(newx, x2[1])
  601.         x2 = x2[2..length(x2)]
  602.     end if
  603.     end while
  604.     newx = newx & x1 & x2 -- one will be empty
  605.     return newx
  606. end function
  607.  
  608. global function bubble(sequence x)
  609. -- put x into ascending order
  610. -- using bubble sort
  611. object temp
  612.  
  613.     for i = 1 to length(x) - 1 do
  614.     for j = i + 1 to length(x) do
  615.         if x[j] < x[i] then
  616.         temp = x[j]
  617.         x[j] = x[i]
  618.         x[i] = temp
  619.         end if
  620.     end for
  621.     end for
  622.     return x
  623. end function
  624.  
  625.  
  626.  -- Prime Sieve Benchmark --
  627. constant SIZE = 8191,
  628.      ON  = 1,
  629.      OFF = 0
  630.  
  631. sequence flags
  632.  
  633. function sieve()
  634.     positive_int count, prime
  635.  
  636.     count = 0
  637.     -- turn flags on (non-zero)
  638.     flags = repeat(ON, SIZE)
  639.     for i = 1 to SIZE do
  640.     if flags[i] then
  641.         prime = i + i + 1
  642.         -- print(prime)
  643.         for k = i + prime to SIZE by prime do
  644.         flags[k] = OFF
  645.         end for
  646.         count = count + 1
  647.     end if
  648.     end for
  649.     return count
  650. end function
  651.  
  652. function fib(integer n)
  653. -- fibonacci
  654.     if n < 2 then
  655.     return n
  656.     else
  657.     return fib(n-1) + fib(n-2)
  658.     end if
  659. end function
  660.  
  661. integer rp
  662.  
  663. procedure recursive_proc()
  664. -- a recursively-called procedure
  665.     if rp > 0 then
  666.     rp = rp - 1
  667.     recursive_proc()
  668.     end if
  669. end procedure
  670.  
  671. without profile
  672.  
  673. global procedure sanity()
  674.     graphics_mode(260)
  675.     clear_screen()
  676.     position(12, 20)
  677.     puts(msg, "Euphoria SANITY TEST ... ")
  678.     testget()
  679.  
  680.     for j = 0 to 8 by 2 do
  681.     if not match("EUPHORIA", getenv("EUDIR")) then
  682.         abort()
  683.     end if
  684.     testgr()
  685.     make_sound()
  686.     same(built_in(), 1)
  687.     atomic_ops()
  688.     overflow()
  689.     floating_pt()
  690.     if compare(sequence_ops(), "BCDE") != 0 then
  691.         puts(msg, "sequence_ops failed\n")
  692.     end if
  693.     sequence_ops2()
  694.     circularity()
  695.     I_O()
  696.     rp = 100
  697.     recursive_proc()
  698.     if rp != 0 then
  699.         puts(msg, "recursive proc failed\n")
  700.     end if
  701.     if fib(20) != 6765 then
  702.         puts(msg, "fib failed\n")
  703.     end if
  704.     if sieve() != 1899 then
  705.         puts(msg, "sieve failed\n")
  706.     end if
  707.     if not sorted(merge_sort(list)) then
  708.         puts(msg, "merge_sort failed\n")
  709.     end if
  710.     if not sorted(bubble(list)) then
  711.         puts(msg, "bubble sort failed\n")
  712.     end if
  713.     if not sorted(sort(-500 + rand(repeat(1000, 1000)))) then
  714.         puts(msg, "standard sort failed\n")
  715.     end if
  716.     if not sorted(sort({"robert", "junko", "dave", "ken", "lurdes"})) then
  717.         puts(msg, "standard general sort failed\n")
  718.     end if
  719.     end for
  720.     printf(msg, "%s\n", {"PASSED (100%)\n\n  <Enter> to continue"})
  721.     if atom(gets(0)) then
  722.     end if
  723.     graphics_mode(3)
  724. end procedure
  725.  
  726. integer z
  727.  
  728. -- another for-loop test
  729. z = 0
  730. for j = 1 to 10 do
  731.     z = z + j
  732. end for
  733. if z != 55 then
  734.     abort()
  735. end if
  736.  
  737. sanity()
  738.  
  739.